home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / STORBASE.I < prev    next >
Encoding:
Modula Implementation  |  1994-06-03  |  48.6 KB  |  1,713 lines
  1. IMPLEMENTATION MODULE StorBase;
  2. (*$Y+,C-,R-*)
  3.  
  4. (*-----------------------------------------------------------------------------
  5.  * Copyright Januar 1987 Thomas Tempelmann, E.L.Kirchner Str.25, 29 Oldenburg
  6.  *-----------------------------------------------------------------------------
  7.  * Kurzbeschreibung : Zentrale Memoryverwaltung für MOS
  8.  *-----------------------------------------------------------------------------
  9.  * Systemversion : MOS 1.1
  10.  * Textversion   : V#0203
  11.  *-----------------------------------------------------------------------------
  12.  * Datum    Vers  Autor  Bemerkung (Arbeitsbericht)
  13.  *-----------------------------------------------------------------------------
  14.  * 09.01.87  0.0  TT     Erste theoretisch lauffähige Komplettversion
  15.  * 04.02.87  1.0  TT     Erste Version unter MOS, Aufruf DeAllocAll bei Term.
  16.  * 10.02.87  1.0  TT     Keine Imports mehr; @SetLevel impl.; alter Process-
  17.  *                       Term-Vektor wird nach eigener Routine angesprungen.
  18.  * 11.02.87  1.0  TT     processTerm: kein TRAP #1-Aufruf mehr
  19.  * 18.02.87  1.1  TT     MDSt-Verwaltung TOS-Kompatibel. Leider keine Freigabe
  20.  *                       der MDSts mehr, da nicht erkennbar, wann ein MDst
  21.  *                       vollkommen frei ist.
  22.  * 21.02.87  1.2  TT     MDSt wird möglichst am Speicherende alloziert.
  23.  *                       SysLevel katalogisiert mit TOS-owner.
  24.  * 22.02.87  1.2  TT     über 408-Vektor wird aller userMemory freigegeben,
  25.  *                       ungerade Längen werden dabei begradigt (Bit 31 in
  26.  *                       owner wird gelöscht).
  27.  * 25.05.87  1.3  TT     TOS-Variablen aus 'TOSPatch' importiert.
  28.  * 14.06.87  1.4  TT     Available-Funktion neu
  29.  * 22.06.87  1.5  TT     Infinite loop in allocU1 verhindert (bei 'notFnd')
  30.  * 01.07.87  1.6  TT     @SetLevel raus, stattdessen SetEnvelope-Verwendung
  31.  * 09.09.87  1.7  TT     Keep, Extend neu; Regs bei DeAllocATE, MemSize gerettet
  32.  * 25.10.87  1.8  TT     Keep jetzt KeepAll; Keep f. einzl. Blocks; MemSize
  33.  *                       liefert auch ungerade Längen; DeAllocAll prüft auch
  34.  *                       Prozeß-ID.
  35.  * 24.11.87  1.9  TT     Levels raus, jeder Level hat eigene Prozeßkennung.
  36.  * 07.01.88  1.10 TT     terminate ruft DeAllocAll nun korrekt auf
  37.  * 24.01.88  1.11 TT     Bei Malloc wird oberes owner-Byte immer # 0 gesetzt
  38.  * 27.01.88  1.12 TT     testMDSt reagiert bei 32 statt 10 freien Einträgen
  39.  * 02.06.88  1.13 TT     Enlarge-Funktion bei 'Resize0'; allocU1 setzte owner
  40.  *                       nicht, wenn amout = ganzem Freibereich war.
  41.  * 17.06.88  1.14 TT     MD-Stack-Vars werden nicht mehr benötigt.
  42.  * 24.07.88  1.15 TT     MPBPtr wird generisch ermittelt.
  43.  * 27.07.88       TT     LongStack wird wieder in getMD benutzt, damit
  44.  *                       Accessories und AUTO-Prgs laufen.
  45.  * 29.07.88       TT     GetMPBPtr korrigiert (Trace-Bit wurde nicht gelöscht)
  46.  * 18.08.88  1.16 TT     LongStack-Vars werden f. TOS 1.0/1.2 hier konstant
  47.  *                       verwendet, ab TOS 1.3 werden die MD nicht mehr selbst
  48.  *                       angelegt/freigegeben, dadurch kein autom. LongStack-
  49.  *                       Erweitern mehr möglich.
  50.  *                       D4 wird nun in ALLOCATE gerettet.
  51.  * 23.08.88       TT     Enlarge f. TOS 1.4 korrig, TrailAvail neu
  52.  * 24.08.88       TT     Register D5/D6 werden bei TrailAvail gerettet;
  53.  *                       owner wird sicherheitshalber bei Enlarge mit vollem
  54.  *                       folg. Freibereich neu gesetzt; In owner wird nicht
  55.  *                       mehr eine eigene Prozeßkennung abgelegt.
  56.  * 01.10.88       TT     SysAlloc macht Speicher nun dauerhaft resident und
  57.  *                       gibt ihn nicht mehr bei Prozeßende des Moduls frei.
  58.  * 23.10.88       TT     ProcessID aus MOSCtrl statt TOSPatch
  59.  * 06.11.88       TT     testMDSt erweitert Pool nicht, wenn dieser noch
  60.  *                       nicht benutzt wurde (wenn Liste leer) oder Stack
  61.  *                       nocht groß genug ist.
  62.  * 11.02.89       TT     Modul in StorBase umbenannt
  63.  * 05.07.89       TT     Wenn MPBPtr nicht gefunden wird, sind die Funktionen
  64.  *                       ALLOCATE, DEALLOCATE, SysAlloc (wie ALLOCATE),
  65.  *                       MemAvail, Available, AllAvail (wie MemAvail)
  66.  *                       weiterhin normal benutzbar. TrailAvail liefert immer
  67.  *                       Null.
  68.  *                       Die Funktionen MemSize, Keep, KeepAll, Enlarge und
  69.  *                       DEALLOCATE mit size # 0L (korrekte Größe geht nicht!)
  70.  *                       lösen bei Aufruf einen Laufzeitfehler (-14,
  71.  *                       IllegalCall) aus.
  72.  *                       Es ist die Aufgabe des neuen Storage-Moduls, diese
  73.  *                       Konventionen einzuhalten!
  74.  * 16.07.90       TT     Enlarge macht keinen Fehler mehr mit ungeraden Werten
  75.  * 29.08.90       TT     DEALLOCATE meldet keinen Fehler mehr, wenn Länge # 0
  76.  *                       und kein MPB-Zugriff; Resize neu
  77.  * 09.10.90       TT     AllAvail berücksichtigt TT-RAM
  78.  * 28.03.91       TT     AllAvail belegt alle Bereiche > 1024, um auch ohne MPB-
  79.  *                       Zugriff sinnvolle Ergebnisse zu liefern.
  80.  * 25.04.91       TT     Neues Verfahren bei GetMPB, läuft nun mit Mega STE
  81.  *                       und wahrscheinlich auch mit PAMs Net.
  82.  * 03.05.91       TT     AllAvail übergibt Wert nicht mehr in D1, so daß GEMDOS
  83.  *                       D1 ruhig zerstören kann.
  84.  * 18.06.91       TT     Enlarge liefert korrekten Ergebniswert.
  85.  * 15.09.91       TT     GetMPBPtr findet offenbar auch auf dem TT den Ptr,
  86.  *                       was aber keinen Sinn macht, da nicht alle Listen
  87.  *                       oder so berücksichtigt werden. Damit da kein Scheiß
  88.  *                       passiert, wird bei TOS 3.x nie nach dem MPB gesucht.
  89.  * 19.01.94       TT     kein GetMPBPtr bei MiNT/MagX
  90.  * 04.04.94       TT     AllAvail vermeidet nun Stacküberlauf
  91.  *----------------------------------------------------------------------------*)
  92.  
  93. (*
  94.  *
  95.  * --> In der Free-List sind alle MD.start aufsteigend geordnet.
  96.  *
  97.  * D6: MPBPtr; D7: =0 -> allocMDSt aktiv.
  98.  *
  99.  * In owner steht im oberen Byte nur noch die Kennung f. ungerade Längen.
  100.  * Wenn ein Programm mit Ptermres endet, passiert es, daß die Speicherblocks,
  101.  * die zu der Zeit eine ungerade Länge haben, nicht dem Prozeß zugehörig
  102.  * erkannt werden und deshalb nicht resident gemacht werden. Zwar werden beim
  103.  * Prozeßende durch 'DeAllocAll' alle owner bereinigt, aber leider wird der
  104.  * Term-Vektor bei Ptermres erst nach Residentmachen des Speichers angesprungen,
  105.  * sodaß 'DeAllocAll' zu spät zum Zuge kommt.
  106.  * Mit diesem kleinen Fehler sollte sich leben lassen, vor Allem, da beim
  107.  * Residentmachen durch 'InstallModule' dieses Problem nicht auftritt.
  108.  *)
  109.  
  110.  
  111. FROM SYSTEM IMPORT ASSEMBLER, ADDRESS, LongWord, ADR, BYTE, WORD;
  112.  
  113. FROM MOSCtrl IMPORT ProcessID;
  114.  
  115. FROM MOSSupport IMPORT CallSuper;
  116.  
  117. FROM MOSGlobals IMPORT IllegalCall, MemArea, Date;
  118.  
  119. FROM MOSConfig IMPORT ExtendedMemoryAccess;
  120.  
  121. FROM PrgCtrl IMPORT EnvlpCarrier, TermCarrier, CatchProcessTerm, SetEnvelope;
  122.  
  123. FROM CookieJar IMPORT GetCookie;
  124.  
  125.  
  126. VAR     MDRoot    : ADDRESS;
  127.         LongStack : ADDRESS;
  128.         LStackPtr : ADDRESS;
  129.         LStackFree: ADDRESS;
  130.  
  131. CONST
  132.  
  133.   minMDs = 32; (* Soviel MDs müssen noch frei sein (s. testMDSt) *)
  134.  
  135.   ElemSize = $480; (* (64 * mdSize2) Um soviel wird der OS-Pool erweitert *)
  136.  
  137.  
  138. TYPE P_MD = POINTER TO MD;
  139.      
  140.      MD = RECORD
  141.             next: P_MD;
  142.             start: Address;
  143.             length: Longcard;
  144.             owner: Longword    (* Bit 31: length ungerade *)
  145.           END;
  146.      
  147.      P_MD2 = POINTER TO MD2;
  148.      
  149.      MD2 = RECORD
  150.              mylen: Integer;  (* Immer = 1 *)
  151.              next: P_MD;
  152.              start: Address;
  153.              length: Longcard;
  154.              owner: Longword
  155.           END;
  156.      
  157. CONST mdSize0 = 16;
  158.       mdSize2 = 18;   (* Plus vorstehendes Längen-word (=1) *)
  159.  
  160.       m_alloc = $48;
  161.       m_free  = $49;
  162.       m_shrink= $4A;
  163.       end_os  = $4FA;
  164.  
  165.  
  166. TYPE P_MPB = POINTER TO MPB;
  167.      
  168.      MPB = RECORD
  169.              free: P_MD;
  170.              used: P_MD;
  171.              boomer: P_MD
  172.            END;
  173.      
  174.  
  175. VAR MPBPtr: P_MPB;
  176.  
  177. VAR oldStorage: BYTE;
  178.  
  179.  
  180. PROCEDURE GetMPBPtr;
  181.   (*$L-*)
  182.   BEGIN
  183.     ASSEMBLER
  184.         ; Malloc (2)
  185.         MOVEQ   #2,D0
  186.         MOVE.L  D0,-(A7)
  187.         MOVE    #$48,-(A7)
  188.         TRAP    #1
  189.         ADDQ.L  #6,A7
  190.         MOVE.L  D0,-(A7)
  191.         
  192.         CLR.L   -(A7)
  193.         MOVE    #$20,-(A7)      ; Super (0)
  194.         TRAP    #1
  195.         MOVE.L  D0,2(A7)
  196.         
  197.         MOVE.L  $4F2,A0         ; ^TOS-Header
  198.         MOVE.L  8(A0),A0        ; wg. altem AHDI
  199.         CMPI.B  #$03,2(A0)
  200.         BEQ.W   error           ; erstmal nicht bei TT wg. Fast-RAM
  201.         
  202.         LEA     $800,A0
  203.         MOVE.L  end_os,D1
  204.         SUB.L   A0,D1
  205.         LSR     #1,D1           ; D1: Anzahl zu suchender Words
  206.         
  207.         ; *** nach dem MD suchen ***
  208.         
  209.         MOVE.L  6(A7),D0        ; zu suchender 'start'
  210.         MOVE.L  ProcessID,A2
  211.         MOVE.L  (A2),D2         ; zu suchender 'owner'
  212.         
  213.         CLR.L   -(A7)           ; Flag: bisher nix gefunden
  214.         
  215.     l1: CMP.W   (A0)+,D0
  216.         DBEQ    D1,l1
  217.         BNE     e1
  218.         CMP.L   -4(A0),D0       ; stimmt 'start'?
  219.         DBEQ    D1,l1
  220.         BNE     e1
  221.         CMPI.L  #2,(A0)         ; stimmt 'length'?
  222.         DBEQ    D1,l1
  223.         BNE     e1
  224.         CMP.L   4(A0),D2        ; stimmt 'owner'?
  225.         DBEQ    D1,l1
  226.         BNE     e1
  227.         
  228.         ; *** MD gefunden ***
  229.         
  230.         TST.L   (A7)+
  231.         BNE     error           ; mehrfach gefunden -> Abbruch
  232.         
  233.         LEA     -8(A0),A1
  234.         MOVE.L  A1,-(A7)        ; Adr. des MD merken
  235.         
  236.         DBRA    D1,l1           ; weitersuchen
  237.  
  238.     e1: MOVE.L  (A7)+,A1
  239.         MOVE.L  A1,D2
  240.         BEQ     error           ; nicht gefunden
  241.         
  242.         ; *** nach möglichen MPBs suchen ***
  243.         
  244.         LEA     $800,A0
  245.         MOVE.L  end_os,D1
  246.         SUB.L   A0,D1
  247.         LSR     #1,D1           ; D1: Anzahl zu suchender Words
  248.         
  249.         CLR.L   -(A7)           ; Endmarke f. gefundene Adressen
  250.         
  251.     l2: CMP.W   (A0)+,D2
  252.         DBEQ    D1,l2
  253.         BNE     e2
  254.         CMP.L   -4(A0),D2       ; steht ^MD in MPB.used?
  255.         DBEQ    D1,l2
  256.         BNE     e2
  257.         ; einen haben wir...
  258.         PEA     -8(A0)
  259.         DBRA    D1,l2           ; weitersuchen
  260.         
  261.     e2:
  262.         ; *** Bereich wieder freigeben. Dann ***
  263.         ; *** steht in MPB.used der ^MD.next ***
  264.         
  265.         MOVE.L  (A1),-(A7)      ; MD.next merken
  266.         MOVE.L  D0,-(A7)
  267.         MOVE    #$49,-(A7)      ; Mfree()
  268.         TRAP    #1
  269.         ADDQ.L  #6,A7
  270.         MOVE.L  (A7)+,D2        ; MD.next
  271.         
  272.         ; *** nochmal die mögl. MPBs prüfen ***
  273.         
  274.     l3: MOVE.L  (A7)+,D0        ; ^MD
  275.         BEQ     e3
  276.         MOVE.L  D0,A0
  277.         CMP.L   4(A0),D2        ; MBP.used = MD.next?
  278.         BNE     l3
  279.         TST.L   MPBPtr
  280.         BNE     err2            ; mehrfach gefunden -> Abbruch
  281.         ; *** MPB gefunden ***
  282.         MOVE.L  A0,MPBPtr
  283.         BRA     l3              ; weitersuchen
  284.         
  285.   err2: TST.L   (A7)+
  286.         BNE     err2
  287.         CLR.L   MPBPtr
  288.  
  289.     e3: TRAP    #1              ; Super (SSP)
  290.         ADDQ.L  #6,A7
  291.         BRA     ende
  292.         
  293.  error: TRAP    #1              ; Super (SSP)
  294.         ADDQ.L  #6,A7
  295.         MOVE    #$49,-(A7)      ; Mfree()
  296.         TRAP    #1
  297.         ADDQ.L  #2,A7
  298.         CLR.L   MPBPtr
  299.  
  300.   ende: ADDQ.L  #4,A7           ; Adr. vom angeforderten Block vom Stack
  301.     END;
  302.   END GetMPBPtr;
  303.  
  304. (* alt:
  305.   PROCEDURE GetMPBPtr;
  306.     (*$L-*)
  307.     BEGIN
  308.       ASSEMBLER
  309.           ; MPB-Root suchen
  310.           CLR.L   MPBPtr
  311.   
  312.           PEA     set_trc(PC)
  313.           MOVE    #4,-(A7)
  314.           MOVE    #5,-(A7)
  315.           TRAP    #13             ; setexec (4, set_trc)
  316.           ADDQ.L  #8,A7
  317.           ILLEGAL
  318.   
  319.           MOVE.L  #-1,-(A7)
  320.           MOVE.W  #$48,-(A7)
  321.           TRAP    #1              ; malloc (-1L)
  322.           ADDQ.L  #6,A7
  323.   
  324.           PEA     rst_trc(PC)
  325.           MOVE    #4,-(A7)
  326.           MOVE    #5,-(A7)
  327.           TRAP    #13             ; setexec (4, rst_trc)
  328.           ADDQ.L  #8,A7
  329.           ILLEGAL
  330.   
  331.           RTS
  332.   
  333.         set_trc:
  334.           MOVE.L  D0,$10          ; vektor #4 wiederherstellen
  335.           LEA     sv_trc(PC),A0
  336.           MOVE.L  $24,(A0)        ; vektor #9 (trace) retten
  337.           LEA     trace(PC),A0
  338.           MOVE.L  A0,$24          ; vektor #9 (trace) setzen
  339.           ORI.W   #$8000,(A7)     ; Trace-Bit setzen
  340.           ADDQ.L  #2,2(A7)        ; PC hinter ILLEGAL-Instr
  341.           RTE
  342.   
  343.         rst_trc:
  344.           MOVE.L  D0,$10          ; vektor #4 wiederherstellen
  345.           MOVE.L  sv_trc(PC),$24  ; vektor #9 (trace) rücksetzen
  346.           ANDI.W  #$3FFF,(A7)     ; Trace-Bit(s) löschen
  347.           ADDQ.L  #2,2(A7)        ; PC hinter ILLEGAL-Instr
  348.           RTE
  349.   
  350.         sv_trc:
  351.           DC.L    0
  352.   
  353.         trace:
  354.           MOVE.L  A0,-(A7)
  355.           MOVE.L  4+2(A7),A0
  356.           CMPI.W  #$4E90,(A0)     ; JMP (A0) - Instr ?
  357.           BEQ     trc2
  358.         trc3
  359.           MOVE.L  (A7)+,A0
  360.           ORI.W   #$8000,(A7)     ; Trace-Bit erneut setzen
  361.           RTE
  362.         trc2:
  363.           LEA     trace2(PC),A0
  364.           MOVE.L  A0,$24          ; setexec (9, trace2)
  365.           BRA     trc3
  366.   
  367.         trace2:
  368.           MOVE.L  A0,-(A7)
  369.           MOVE.L  4+2(A7),A0
  370.           CMPI.W  #$6100,(A0)     ; JSR x.L - Instr ?
  371.           BEQ     trc4
  372.           MOVE.L  (A7)+,A0
  373.           RTE
  374.         trc4:
  375.           CMPI.L  #-1,4+6(A7)     ; steht -1 (malloc-param) auf Stack ?
  376.           BNE     trc_err         ; nicht gefunden
  377.           TST.B   4+6+4(A7)       ; ist Adr. v. MPB < $1000000 ?
  378.           BNE     trc_err         ; nicht gefunden
  379.           MOVE.L  4+6+4(A7),MPBPtr ; auf Supervisor-Stack steht MPB-Pointer
  380.         trc_err
  381.           MOVE.L  (A7)+,A0
  382.           ANDI.W  #$7FFF,(A7)     ; Trace-Bit löschen
  383.           RTE
  384.       END
  385.     END GetMPBPtr;
  386.     (*$L=*)
  387. *)
  388.  
  389.  
  390. (*$L-*)
  391. PROCEDURE IllCall;
  392.   BEGIN
  393.     ASSEMBLER
  394.         TRAP    #6
  395.         DC.W    IllegalCall-$C000       ; caller caused, Text folgt
  396.         ACZ     'StorBase: no MPB!'
  397.         SYNC
  398.     END
  399.   END IllCall;
  400.  
  401.  
  402. (*$L-*)
  403. PROCEDURE initMDSt;
  404. BEGIN
  405. ASSEMBLER
  406. ; D0: pMD
  407.         MOVE.L  D0,A0
  408.         MOVE.L  MD.length(A0),D5
  409.         MOVE.L  MD.start(A0),A1
  410.         
  411.         ADDQ.L  #2,A1
  412.         MOVEQ   #mdSize2,D2
  413.         
  414.         ; Ende der MD-Freiliste suchen
  415.         MOVE.L  MDRoot,A0
  416. l0      TST.L   (A0)
  417.         BEQ     st0
  418.         MOVE.L  (A0),A0
  419.         BRA     l0
  420.         
  421. nxt     MOVE    #1,-2(A1)       ; MD.mylen
  422.         MOVE.L  A1,(A0)         ; Adr. des MD dem Vorgänger in MD.next zuweisen
  423.         MOVE.L  A1,A0
  424.         ADDA.L  D2,A1
  425. st0     SUB.L   D2,D5
  426.         BCC     nxt
  427.         
  428.         ; letztes Element mit NIL markieren
  429.         CLR.L   (A0)            ; MD.next
  430. END;
  431. END initMDSt;
  432.  
  433.  
  434. FORWARD allocU1;
  435.  
  436. (*$L-*)
  437. PROCEDURE testMDSt;
  438.   CONST lstsize = 32 * 9;
  439.   BEGIN
  440.     ASSEMBLER
  441.         
  442.         TST     D7
  443.         BEQ     ende            ; Rekursionen mögen wir nicht
  444.  
  445.         MOVE.L  MDRoot,A0
  446.         MOVE.L  (A0),D0
  447.         BEQ     ende            ; Keine Erweiterung, wenn noch kein Pool exist.
  448.  
  449.         MOVE.L  LStackFree,A0
  450.         MOVE.W  (A0),D1
  451.         DIVU    #9,D1           ; D1: Anz. freier MD-Plätze
  452.         SUBI    #minMDs,D1      ; mind. benötigte freie Anzahl
  453.         BCC     ende            ; noch genug frei
  454.         NEG     D1              ; -> fehlende Anzahl in Liste prüfen
  455.         SUBA.L  A0,A0
  456. loop0   MOVE.L  0(A0,D0.L),D0
  457.         DBEQ    D1,loop0
  458.         BNE     ende
  459. gotit
  460.         ; Neuen MDSt anlegen
  461.         
  462.         ; Size v. elems*16 als amount
  463.         MOVE.L  #ElemSize,D5
  464.         MOVEQ   #0,D3
  465.         CLR     D7
  466.         MOVEQ   #0,D4           ; owner = 0L
  467.         JSR     allocU1         ; D6 (MPBPtr) stimmt wohl noch
  468.         MOVEQ   #1,D7
  469.         
  470.         TST.L   D0
  471.         BEQ     ende
  472.         
  473.         JSR     initMDSt
  474. ende
  475. END;
  476. END testMDSt;
  477.  
  478.  
  479. (*$L-*)
  480. PROCEDURE getMD;  (* Ergebnis in D0 *)
  481. BEGIN
  482. ASSEMBLER
  483.         ; D3 erhalten !
  484.         ; D4: owner
  485.         
  486.         MOVE.L  MDRoot,A0
  487.         TST.L   (A0)
  488.         BEQ     instack
  489.         
  490.         MOVE.L  (A0),A1
  491.         MOVE.L  (A1),(A0)
  492.         MOVE.L  A1,D0
  493.         BRA     ende
  494.         
  495. instack MOVEQ   #0,D0
  496.         MOVE.L  LStackFree,A0
  497.         CMPI.W  #9,(A0)        ; noch Platz im Stack ?
  498.         BLS     ende
  499.         SUBI.W  #9,(A0)        ; freie Elemente in Stack
  500.         MOVE.L  LStackPtr,A0
  501.         MOVE.W  (A0),D0        ; Stackpointer
  502.         ASL.W   #1,D0          ; *2
  503.         EXT.L   D0
  504.         MOVE.L  D0,A1
  505.         ADDA.L  LongStack,A1
  506.         ADDI.W  #9,(A0)        ; Stackpointer erhöhen
  507.         MOVE.W  #1,(A1)        ; die Länge des Elements im Element ablegen
  508.         ADDQ.L  #2,A1
  509.         MOVE.L  A1,D0
  510.         
  511. ende    MOVE.L  D4,MD.owner(A1)
  512. END
  513. END getMD;
  514.  
  515.  
  516. (*$L-*)
  517. PROCEDURE linkFree; (* Linkt MD mit Nachfolger zusammen. *)
  518. BEGIN
  519. ASSEMBLER
  520.         ; A0: ^vor-vorigen MD
  521.         
  522.         MOVE.L  (A0),A4                 ; (MD.next)  Adr. des vorigen MD
  523.         MOVE.L  (A4),A1                 ; (MD.next)  Adr. des MD
  524.         ; A1 auslinken
  525.         MOVE.L  MD.length(A1),D0        ; Länge des Folgenden
  526.         ADD.L   D0,MD.length(A4)        ; Auf Länge des MD aufaddieren
  527.         MOVE.L  (A1),(A4)               ; Folgenden MD auslinken
  528.         MOVE.L  D6,A0
  529.         CMPA.L  MPB.boomer(A0),A1
  530.         BNE     @FC8801
  531.         MOVE.L  A4,MPB.boomer(A0)
  532. @FC8801 ; MD aus TOS-Stack austragen
  533.         MOVE.L  MDRoot,A0
  534.         MOVE.L  (A0),(A1)
  535.         MOVE.L  A1,(A0)
  536.         SUBA.L  A1,A1
  537. ende
  538. END
  539. END linkFree;
  540.  
  541.  
  542. (*$L-*)
  543. PROCEDURE insertFree;
  544. BEGIN
  545. ASSEMBLER
  546.         ; Trägt einen ungelinkten MD in Freiliste ein
  547.         ; pMD wird in D0 übergeben
  548.         
  549.         MOVE.L  A4,-(A7)
  550.         MOVE.L  D0,A4
  551.         MOVE.L  D6,A0
  552.         LEA     (A0),A2
  553.         MOVE.L  (A0),A1         ; MPB.free
  554.         
  555.         ; Wir suchen in Freelist die MDs, zw. die der neue MD paßt.
  556.         BRA     cont2
  557. srch2   MOVE.L  MD.start(A4),D0 ; start des freizugebenden Bereichs
  558.         CMP.L   MD.start(A1),D0 ; start aus Free-List
  559.         BLE     fnd2            ; Hier paßt er hin
  560.         MOVE.L  A2,D1
  561.         MOVE.L  A1,A2           ; Vorgänger retten
  562.         MOVE.L  (A2),A1         ; MD.next
  563. cont2   MOVE.L  A1,D0
  564.         BNE     srch2
  565. fnd2
  566.         ; Neuer Freibereich wird in Free-list eingelinkt:
  567.         MOVE.L  A1,(A4)         ; MD.next des freizug. Bereichs setzen
  568.         MOVE.L  A4,(A2)         ; Adr. des freizugebenden Bereichs einlinken
  569.         
  570.         ; boomer-^ setzen, falls er NIL ist
  571.         MOVE.L  D6,A0
  572.         TST.L   MPB.boomer(A0)
  573.         BNE     exists
  574.         MOVE.L  A4,MPB.boomer(A0)
  575. exists
  576.         ; Liegt hinter dem freigewordenen Bereich noch ein freier ?
  577.         MOVE.L  A1,D0
  578.         BEQ     noNext
  579.         MOVE.L  MD.start(A4),D0         ; Start des neuen Freibereichs
  580.         ADD.L   MD.length(A4),D0        ; Plus Länge des neuen Freibereichs
  581.         CMP.L   MD.start(A1),D0         ; = Beginn des folgenden Freibereichs ?
  582.         BNE     noNext                  ; Nö
  583.         
  584.         ; Die beiden Freibereiche verketten
  585.         MOVE.L  A2,A0
  586.         MOVEM.L A4/A2,-(A7)
  587.         JSR     linkFree
  588.         MOVEM.L (A7)+,A4/A2
  589.         BRA     cont1
  590.         
  591. noNext  SUBA.L  A1,A1
  592. cont1   ; Liegt vor dem freigewordenen Bereich noch ein freier ?
  593.         CMP.L   A2,D6
  594.         BEQ     ende                    ; kein voriger Bereich
  595.         MOVE.L  MD.start(A2),D0         ; Start des Bereichs des Vorgängers
  596.         ADD.L   MD.length(A2),D0        ; Plus Länge des Vorgängerbereichs
  597.         CMP.L   MD.start(A4),D0         ; = Beginn des neuen Freibereichs ?
  598.         BNE     ende                    ; Nö
  599.         
  600.         ; Die beiden Freibereiche verketten
  601.         MOVE.L  D1,A0
  602.         JSR     linkFree
  603.         
  604. ende    MOVE.L  (A7)+,A4
  605. END
  606. END insertFree;
  607.  
  608.  
  609. (*$L-*)
  610. PROCEDURE Resize1;  (* liefert in D0.W Boolean, ob alles geklappt *)
  611. BEGIN
  612. ASSEMBLER
  613.         ; length in D4, ^block-Adr in D5
  614.         ;MOVE    SR,-(A7)
  615.         ;ORI     #$700,SR
  616.         
  617.         ; Neuer MDSt nötig ?
  618.         MOVEM.L D4/D5,-(A7)
  619.         JSR     testMDSt
  620.         MOVEM.L (A7)+,D4/D5
  621.         
  622.         MOVE.L  D5,A0
  623.         MOVE.L  (A0),D3
  624.         
  625.         ; belegten Bereich suchen
  626.         MOVE.L  D6,A2
  627.         ADDQ.L  #MPB.used,A2    ; LEA MPB.used(A2),A2
  628.         BRA     cont0
  629. srch0   CMP.L   MD.start(A1),D3
  630.         BEQ     found0
  631.         MOVE.L  A1,A2
  632. cont0   MOVE.L  (A2),A1         ; MD.next
  633.         MOVE.L  A1,D0
  634.         BNE     srch0
  635.         
  636.         ; Nicht gefunden in Free-Liste
  637.         CLR.L   (A0)            ; Variable auf NIL
  638.         BRA.L   ende
  639.         
  640. found0  TST.L   D4
  641.         BEQ     freeAll
  642.         MOVE.L  MD.length(A1),D1
  643.         MOVE.B  MD.owner(A1),D0
  644.         BPL     even
  645.         SUBQ.L  #1,D1
  646. even    TST.L   D4
  647.         BMI     enlarg
  648.         SUB.L   D4,D1           ; neuer User-amount
  649.         BHI.W   shrink
  650.         
  651. freeAll MOVE.L  (A1),(A2)       ; MD auslinken
  652.         CLR.L   (A0)            ; Variable auf NIL
  653.         MOVE.L  A1,D0
  654.         BRA.W   freeIt
  655.  
  656. endeOK2 MOVE.B  D0,MD.owner(A1)
  657.         BRA.W   endeOK
  658.  
  659. ende2   MOVEQ   #0,D0
  660.         BRA.W   ende
  661.  
  662. enlarg  ; amount vergrößern
  663.         SUB.L   D4,D1           ; neuer, vergrößerter, User-amount
  664.         ANDI    #$7F,D0
  665.         BTST    #0,D1
  666.         BEQ     even4
  667.         ADDQ.L  #1,D1
  668.         ORI     #$80,D0
  669. even4   CMP.L   MD.length(A1),D1        ; Bleibt bisherige Wort-Länge gleich ?
  670.         BEQ     endeOK2                 ; dann fertig
  671.         MOVE.W  D0,-(A7)
  672.         MOVE.L  MD.start(A1),D2
  673.         ADD.L   MD.length(A1),D2        ; hier muß ein Freibereich stehen
  674.         ; erstmal prüfen, ob noch genügend Platz dahinter frei ist
  675.         MOVE.L  D6,A0
  676.         LEA     MPB.free(A0),A2
  677.         MOVE.L  (A2),A0
  678.         BRA     cont2
  679. srch2   CMP.L   MD.start(A0),D2 ; start aus Free-List
  680.         BEQ     fnd2            ; gefunden
  681.         MOVE.L  A0,A2           ; Vorgänger retten
  682.         MOVE.L  (A2),A0         ; MD.next
  683. cont2   MOVE.L  A0,D0
  684.         BNE     srch2
  685.         MOVE.W  (A7)+,D0
  686.         BRA.W   ende2           ; war wohl nix
  687. fnd2    MOVE.W  (A7)+,D0
  688.         MOVE.L  MD.length(A0),D4 ; free-Länge
  689.         MOVE.L  D4,D2
  690.         ADD.L   MD.length(A1),D4 ; used-Länge
  691.         SUB.L   D1,D4           ; ist Gesamtbereich > neue Länge ?
  692.         BCS     ende2           ;   nein -> Ende
  693.         BEQ     remfmd          ;   sogar gleich, dann free-MD löschen
  694.         MOVE.B  D0,MD.owner(A1) ; Byte-Länge setzen
  695.         ; Used vergrößern, Free verkleinern
  696.         MOVE.L  D1,MD.length(A1) ; neue Used-Größe
  697.         MOVE.L  D4,MD.length(A0) ; neue Free-Größe
  698.         SUB.L   D4,D2            ; Diff zw. alter und neuer Used-Länge
  699.         ADD.L   D2,MD.start(A0)  ; neuer Free-Start
  700.         BRA     endeOK
  701. remfmd  ; Freibereich wird ganz belegt -> Free-MD auslinken
  702.         MOVE.B  D0,MD.owner(A1) ; Byte-Länge setzen
  703.         MOVE.L  (A0),(A2)       ; Free-MD auslinken
  704.         MOVE.L  D6,A1
  705.         CMPA.L  MPB.boomer(A1),A0 ; zeigt boomer auf ausgelinkten MD ?
  706.         BNE     @FC8801
  707.         MOVE.L  A2,MPB.boomer(A1) ; dann auf Vorgänger
  708. @FC8801 ; MD aus TOS-Stack austragen
  709.         MOVE.L  MDRoot,A1
  710.         MOVE.L  (A1),(A0)       ; MD in MDStack einlinken
  711.         MOVE.L  A0,(A1)
  712.         BRA     endeOK
  713.  
  714. shrink  ; newSize in D1, ^used-MD in A1
  715.         ANDI    #$7F,D0
  716.         BTST    #0,D1
  717.         BEQ     even2
  718.         ADDQ.L  #1,D1
  719.         ORI     #$80,D0
  720. even2   MOVE.B  D0,MD.owner(A1)
  721.         CMP.L   MD.length(A1),D1        ; Bleibt bisherige Länge gleich ?
  722.         BEQ     endeOK                  ; dann bleibt's beim Alten
  723.         MOVEM.L D1/A1,-(A7)
  724.         MOVEQ   #0,D4
  725.         JSR     getMD                   ; get new MD
  726.         MOVEM.L (A7)+,D1/A1
  727.         TST.L   D0                      ; Keinen MD bekommen ?
  728.         BEQ     ende                    ; Macht nix.
  729.         MOVE.L  D0,A2                   ; Adr. des neuen MD
  730.         MOVE.L  MD.start(A1),D0         ; Start des belegten Bereichs
  731.         ADD.L   D1,D0                   ; Plus neue Größe
  732.         MOVE.L  D0,MD.start(A2)         ; Ergibt Start des neuen Freibereichs
  733.         MOVE.L  MD.length(A1),D0        ; Bisherige Used-Länge
  734.         SUB.L   D1,D0                   ; Minus neue Größe
  735.         MOVE.L  D0,MD.length(A2)        ; Ergibt neue Freilänge
  736.         BNE     qw1
  737.         BREAK
  738.       qw1:
  739.         MOVE.L  D1,MD.length(A1)        ; Belegt-Länge korrigieren
  740.         BNE     qw2
  741.         BREAK
  742.       qw2:
  743.         MOVE.L  A2,D0
  744. freeIt  JSR     insertFree
  745.  
  746. endeOK  MOVEQ   #1,D0
  747.  
  748. ende    ;MOVE    (A7)+,SR
  749. END;
  750. END Resize1;
  751.  
  752.  
  753. (*$L-*)
  754. PROCEDURE findMD; (* D6: MPBPtr, D5: start *)
  755. BEGIN
  756. ASSEMBLER
  757.         MOVE.L  D6,A0
  758.         MOVE.L  MPB.used(A0),A0
  759.       s CMP.L   MD.start(A0),D5
  760.         BEQ     f
  761.         MOVE.L  (A0),A0
  762.         MOVE.L  A0,D0
  763.         BNE     s
  764.       f MOVE.L  A0,D0
  765. END
  766. END findMD;
  767.  
  768.  
  769. (*$L-*)
  770. PROCEDURE resize2; (* D6: MPBPtr, D5: start, D3: ADR(p), D4: len *)
  771. BEGIN
  772. ASSEMBLER
  773.         TST.L   D4
  774.         BEQ     all
  775.         
  776.         JSR     findMD
  777.         BEQ.W   endeClrF
  778.  
  779.         MOVE.L  MD.length(A0),D1
  780.         MOVE.B  MD.owner(A0),D0
  781.         BPL     even
  782.         SUBQ.L  #1,D1
  783. even    SUB.L   D4,D1           ; neuer User-amount
  784.         BLE.W   all
  785.  
  786.         ANDI    #$7F,D0
  787.         BTST    #0,D1
  788.         BEQ     even2
  789.         ADDQ.L  #1,D1
  790.         ORI     #$80,D0
  791. even2   CMP.L   MD.length(A0),D1        ; Bleibt bisherige Länge gleich ?
  792.         BEQ     endeSet                 ; dann bleibt's beim Alten
  793.  
  794.         TST.L   D4
  795.         BMI     enlarg
  796.  
  797.         ; Mshrink ausführen
  798.         MOVE.B  D0,MD.owner(A0)
  799.         MOVE.L  D1,-(A7)        ; neue Länge
  800.         MOVE.L  D5,-(A7)        ; start
  801.         CLR     -(A7)
  802.         MOVE    #m_shrink,-(A7)
  803.         TRAP    #1              ; Mshrink (p)
  804.         ADDA.W  #12,A7
  805.         BRA.W   endeT
  806.  
  807. all     MOVE.L  D5,-(A7)
  808.         MOVE    #m_free,-(A7)
  809.         TRAP    #1              ; Mfree (p)
  810.         ADDQ.L  #6,A7
  811.         MOVE.L  D3,A0
  812.         CLR.L   (A0)
  813.         TST.L   D0
  814.         BEQ.W   endeT
  815.         BRA.W   endeF
  816.  
  817. enlarg  ; anschließenden Free-MD ermitteln
  818.         MOVE.L  D1,D4                   ; neue gerundete Länge
  819.         SUB.L   MD.length(A0),D4        ; D4: neue gerundete Längendiff. (pos.)
  820.         MOVE    D0,-(A7)
  821.         MOVE.L  MD.start(A0),D2
  822.         ADD.L   MD.length(A0),D2        ; hier muß ein Freibereich stehen
  823.         MOVE.L  D6,A2
  824.         MOVE.L  MPB.free(A2),A2
  825.         BRA     cont2
  826. srch2   CMP.L   MD.start(A2),D2 ; start aus Free-List
  827.         BEQ     fnd2            ; gefunden
  828.         MOVE.L  (A2),A2         ; MD.next
  829. cont2   MOVE.L  A2,D0
  830.         BNE     srch2
  831.         MOVE    (A7)+,D0
  832.         BRA     endeF           ; dahinter nix mehr frei
  833. fnd2    MOVE    (A7)+,D0
  834.         MOVE.L  MD.length(A2),D2 ; free-Länge
  835.         ADD.L   MD.length(A0),D2 ; plus used-Länge ergibt gesamte verfügb. Länge
  836.         SUB.L   D1,D2           ; minus neue benötigte Länge ist Rest-Freilänge
  837.         BCS     endeF           ; reicht nicht aus
  838.         BEQ     replace         ; da wird's schwierig...
  839.         MOVE.L  D2,MD.length(A2) ; free-Länge korrigieren
  840.         ADD.L   D4,MD.start(A2)  ; free-Start korrigieren
  841.         MOVE.L  D1,MD.length(A0) ; used-Länge korrigieren
  842.  
  843. endeSet MOVE.B  D0,MD.owner(A0)
  844.         BRA     endeT
  845.  
  846. replace ; der Frei-Bereich muß entfernt werden.
  847.         ; dazu wird der Used-Bereich freigegeben und dann wieder in einen
  848.         ; used-Bereich zurückverwandelt
  849.         MOVE.L  D5,-(A7)
  850.         MOVE    #m_free,-(A7)
  851.         TRAP    #1              ; Mfree (p)
  852.         ADDQ.L  #6,A7
  853.  
  854.         ; MD in Freibereich wiederfinden
  855.         MOVE.L  D6,A0
  856.       s MOVE.L  A0,A1           ; Vorgänger retten
  857.         MOVE.L  (A0),A0
  858.         CMP.L   MD.start(A0),D5
  859.         BNE     s
  860.         ; MD aushängen und in Used-List einhängen
  861.         MOVE.L  (A0),(A1)
  862.         MOVE.L  D6,A2
  863.         CMPA.L  MPB.boomer(A2),A0
  864.         BNE     bok
  865.         MOVE.L  A1,MPB.boomer(A2)
  866. bok     MOVE.L  MPB.used(A2),MD.next(A0)
  867.         MOVE.L  A0,MPB.used(A2)
  868.  
  869. endeT   MOVEQ   #1,D0
  870.         RTS
  871.  
  872. endeClrF
  873.         MOVE.L  D3,A0
  874.         CLR.L   (A0)
  875. endeF   MOVEQ   #0,D0
  876. END
  877. END resize2;
  878.  
  879.  
  880. (*$L+*)
  881. PROCEDURE Resize0 ( VAR p: Address; len: Longint ): Boolean;
  882. VAR res:Boolean;
  883. BEGIN
  884. ASSEMBLER
  885.         MOVEM.L D3-D7,-(A7)
  886.         CLR     D0
  887.         MOVE.L  p(A6),A0
  888.         MOVE.L  A0,D3
  889.         MOVE.L  (A0),D5
  890.         BEQ     ende            ; 'p' ist NIL
  891.         MOVE.L  MPBPtr,D6
  892.         MOVE.L  len(A6),D4
  893.  
  894.         TST.B   oldStorage
  895.         BEQ     newsto
  896.  
  897.         ; Verändern der Größe
  898.         MOVEQ   #1,D7
  899.         MOVE.L  D3,D5
  900.         MOVE.L  #Resize1,-(A7)
  901.         JSR     CallSuper
  902.         ADDQ.L  #4,A7
  903.         BRA     ende
  904.  
  905. newsto  ; Verändern der Größe
  906.         PEA     Resize2
  907.         JSR     CallSuper
  908.         ADDQ.L  #4,A7
  909.  
  910. ende    MOVEM.L (A7)+,D3-D7
  911.         MOVE    D0,res(A6)
  912. END;
  913. RETURN res
  914. END Resize0;
  915.  
  916. (*$L-*)
  917. PROCEDURE freeAll;
  918. BEGIN
  919. ASSEMBLER
  920.         MOVE.L  (A3),D2
  921.         MOVE.L  MPBPtr,A2
  922.         ADDQ.L  #MPB.used,A2    ; LEA MPB.used(A2),A2
  923.         BRA     cont0
  924. srch0   MOVE.L  MD.owner(A2),D1
  925.         ANDI.L  #$00FFFFFF,D1   ; oberes Byte ausblenden wg. Ungerade-Kennung
  926.         CMP.L   D1,D2
  927.         BNE     cont0
  928.         CLR.B   MD.owner(A2)
  929. cont0   MOVE.L  (A2),A2         ; MD.next
  930.         MOVE.L  A2,D1
  931.         BNE     srch0
  932. END;
  933. END freeAll;
  934.  
  935.  
  936. (*$L-*)
  937. PROCEDURE DeAllocAll ( owner: LONGWORD );
  938. BEGIN
  939. ASSEMBLER
  940.         SUBQ.L  #4,A3
  941.         MOVE.L  MPBPtr,D0
  942.         BEQ     ende            ; Wenn kein MPBPtr, ist dies unnötig
  943.         MOVE.L  #freeAll,-(A7)
  944.         JSR     CallSuper
  945.         ADDQ.L  #4,A7
  946. ende
  947. END
  948. END DeAllocAll;
  949.  
  950.  
  951. (*$L-*)
  952. PROCEDURE allocU1; (* D6:MPBPtr, D5:amount, D4:owner *)
  953. BEGIN
  954. ASSEMBLER
  955.         ; A1: zeigt auf aktuellen Free-MD
  956.         ; A2: zeigt auf Vorgänger
  957.         
  958.         MOVE.L  D4,-(A7)
  959.         
  960.         ; Neuen MDSt anlegen ?
  961.         MOVEM.L D3/D5,-(A7)
  962.         JSR     testMDSt
  963.         MOVEM.L (A7)+,D3/D5
  964.         
  965.         MOVE.L  D6,A0
  966.         MOVE.L  MPB.boomer(A0),A2
  967.         MOVE.L  A2,D0
  968.         BEQ.L   ende                    ; keine Freiliste !?
  969.         
  970.         MOVE.L  (A2),A1                 ; ^ Root Freiliste
  971.         CLR.L   D4                      ; höchste Adr.
  972.         
  973. srch1   MOVE.L  A1,D0                   ; Ende der Freiliste ?
  974.         BNE     srch2
  975.         MOVE.L  D6,A2                   ; Ja
  976.         MOVE.L  (A2),A1                 ; MPB.free
  977.         
  978. srch2   MOVE.L  MD.length(A1),D0
  979.         CMP.L   D5,D0
  980.         BEQ     isEqu
  981.         BHI     isHi            ; Der Bereich ist größer
  982.         BRA.L   notFnd          ; Der Freibereich ist zu klein
  983.  
  984. extrem  ; möglichst hohe Adr. suchen
  985.         CMP.L   MD.start(A1),D4
  986.         BCC.L   notFnd
  987.         MOVE.L  MD.start(A1),D4
  988.         MOVE.L  A1,A3
  989.         MOVE.L  A3,A4
  990.         BRA.W   notFnd
  991.  
  992. isEqu   ; Der freie Bereich paßt genau.
  993.         TST     D7
  994.         BEQ     extrem
  995. isEqu0  MOVE.L  (A1),(A2)       ; MD aus Free-Liste auslinken
  996.         MOVE.L  (A7),MD.owner(A1)
  997.         BRA     found
  998.         
  999. isHi    TST     D7
  1000.         BEQ     extrem
  1001.         ; Eintrag des neuen Used-MD, A0: ^ auf neuen Used-MD
  1002. isHi0   MOVE.L  (A7),D4
  1003.         MOVEM.L D5/A1/A2,-(A7)
  1004.         JSR     getMD           ; Legt MD an, liefert Adr. in D0
  1005.         MOVEM.L (A7)+,D5/A1/A2
  1006.         TST.L   D0
  1007.         BEQ.L   ende
  1008.         MOVE.L  D0,A0
  1009.         
  1010.         TST     D7                      ; oberen Bereich abknapsen ?
  1011.         BNE     takeLow
  1012.         
  1013.         MOVE.L  MD.start(A1),D0         ; Used-start auf alten Freibereich
  1014.         ADD.L   MD.length(A1),D0        ; Used-start auf Ende des Bereichs
  1015.         SUB.L   D5,D0                   ; Minus Bereichslänge
  1016.         MOVE.L  D0,MD.start(A0)         ; Als Used-Start
  1017.         SUB.L   D5,MD.length(A1)        ; Frei-Länge um belegten Bereich verkl.
  1018.         BNE     qw1
  1019.         BREAK
  1020.       qw1:
  1021.         MOVE.L  D5,MD.length(A0)        ; Used-Length setzen.
  1022.         BNE     qw2
  1023.         BREAK
  1024.       qw2:
  1025.         MOVE.L  A0,A1                   ; A1:=Adr (Used-MD)
  1026.         BRA     found
  1027.         
  1028. takeLow MOVE.L  MD.start(A1),MD.start(A0) ; Used-start auf alten Freibereich
  1029.         ADD.L   D5,MD.start(A1)         ; Frei-Beginn um bel. Bereich erhöhen
  1030.         SUB.L   D5,MD.length(A1)        ; Frei-Länge um belegten Bereich verkl.
  1031.         BNE     qw3
  1032.         BREAK
  1033.       qw3:
  1034.         MOVE.L  D5,MD.length(A0)        ; Used-Length setzen.
  1035.         BNE     qw4
  1036.         BREAK
  1037.       qw4:
  1038.         MOVE.L  D0,A1                   ; A1:=Adr (Used-MD)
  1039.         
  1040. found   MOVE.L  D6,A0
  1041.         MOVE.L  MPB.used(A0),(A1)       ; MD in Used-Liste einlinken
  1042.         MOVE.L  A1,MPB.used(A0)         ; Neuen Used-MD als Used-Listenbeginn
  1043.         
  1044.         ; Den boomer-^ korrigieren
  1045.         MOVE.L  D6,A0
  1046.         MOVE.L  A2,MPB.boomer(A0)
  1047.         
  1048.         MOVE.B  D3,MD.owner(A1)
  1049.         
  1050.         MOVE.L  A1,D0           ; Ergebnis
  1051.         BRA     ende            ; jetzt ham wir's
  1052.         
  1053. notFnd  MOVE.L  A1,A2
  1054.         MOVE.L  (A1),A1                 ; MD.next
  1055.         
  1056.         MOVE.L  D6,A0
  1057.         MOVE.L  MPB.boomer(A0),D0
  1058.         CMP.L   D0,D6
  1059.         BEQ     notFC2                  ; boomer zeigt auf eigenen MD / MPB
  1060.         
  1061.         CMP.L   A2,D0
  1062.         BNE     srch1
  1063.         BRA     srchEnd
  1064.         
  1065. notFC2  MOVE.L  A1,D0                   ; Ende der Freiliste ?
  1066.         BNE     rovnen2
  1067.         MOVE.L  D6,A2                   ; Ja
  1068.         MOVE.L  (A2),A1                 ; MPB.free
  1069. rovnen2 MOVE.L  D6,A0
  1070.         CMPA.L  MPB.boomer(A0),A2
  1071.         BNE     srch2
  1072.         
  1073. srchEnd TST     D7
  1074.         BNE     ende0
  1075.         TST.L   D4
  1076.         BEQ     ende0           ; kein Platz gef.
  1077.         MOVE.L  A3,A1
  1078.         MOVE.L  A4,A2
  1079.         MOVE.L  MD.length(A1),D0
  1080.         CMP.L   D5,D0
  1081.         BEQ     isEqu0
  1082.         BHI     isHi0           ; Der Bereich ist größer
  1083.         
  1084. ende0   CLR.L   D0              ; keinen Platz gefunden
  1085. ende    ADDQ.L  #4,A7
  1086. END
  1087. END allocU1;
  1088.  
  1089.  
  1090. (*$L-*)
  1091. PROCEDURE allocU2; (* D6:MPBPtr, D5: start, D4:owner *)
  1092. BEGIN
  1093. ASSEMBLER
  1094. END
  1095. END allocU2;
  1096.  
  1097. (*$L-*)
  1098. PROCEDURE Malloc ( amount: Longcard; prID: LONGWORD ): Address;
  1099. BEGIN
  1100. ASSEMBLER
  1101.         MOVEM.L D3-D7,-(A7)
  1102.         
  1103.         MOVE.L  -(A3),D4
  1104.         MOVE.L  -(A3),D5
  1105.         BLE     endeClr
  1106.         ADDQ.L  #1,D5
  1107.         BCLR    #0,D5           ; Sync; keine ungeraden Adr.
  1108.         SEQ     D3              ; D3 wird $FF, wenn amount ungerade war.
  1109.         AND     #$80,D3
  1110.         MOVE.L  MPBPtr,D6
  1111.  
  1112.         TST.B   oldStorage
  1113.         BEQ     newsto
  1114.  
  1115.         MOVEQ   #1,D7
  1116.         MOVE.L  #allocU1,-(A7)
  1117.         JSR     CallSuper
  1118.         ADDQ.L  #4,A7
  1119.         
  1120.         TST.L   D0              ; Adr. des alloz. Bereichs
  1121.         BEQ     ende
  1122.         MOVE.L  D0,A1
  1123.         MOVE.L  MD.start(A1),D0
  1124.         BRA     ende
  1125. endeClr CLR.L   D0
  1126. ende    MOVE.L  D0,(A3)+
  1127.         BRA     ende0
  1128.  
  1129. newsto  ; Malloc ohne LongStack-Zugriffe
  1130.         ; Dazu erst den Speicher über GEMDOS anfordern und dann
  1131.         ; den Owner und evtl. Markierung f. ungeraden Amount setzen
  1132.         MOVE.L  D5,-(A7)
  1133.         MOVE    #m_alloc,-(A7)
  1134.         TRAP    #1              ; Malloc (D5)
  1135.         ADDQ.L  #6,A7
  1136.         MOVE.L  D0,(A3)+
  1137.         BEQ     ende0           ; Kein Speicher mehr -> Ende
  1138.  
  1139.         TST.L   D6
  1140.         BEQ     ende0           ; Nicht Owner/Odd setzen, wenn MPBPtr fehlt
  1141.  
  1142.         MOVE.L  D0,D5
  1143.         PEA     findMD
  1144.         JSR     CallSuper
  1145.         ADDQ.L  #4,A7
  1146.         TST.L   D0
  1147.         BEQ     ende0
  1148.         MOVE.L  D4,MD.owner(A0)
  1149.         MOVE.B  D3,MD.owner(A0)
  1150.  
  1151. ende0:  MOVEM.L (A7)+,D3-D7
  1152. END;
  1153. END Malloc;
  1154.  
  1155.  
  1156. (*$L-*)
  1157. PROCEDURE ALLOCATE ( VAR addr: ADDRESS; len: LONGCARD );
  1158.   BEGIN
  1159.     ASSEMBLER
  1160.         MOVE.L  ProcessID,A0
  1161.         MOVE.L  (A0),(A3)+
  1162.         JSR     Malloc
  1163.         MOVE.L  -(A3),D0
  1164.         MOVEA.L -(A3),A0
  1165.         MOVE.L  D0,(A0)
  1166.     END
  1167.   END ALLOCATE;
  1168.  
  1169. (*$L-*)
  1170. PROCEDURE SysAlloc ( VAR addr: ADDRESS; len: LONGCARD );
  1171.   BEGIN
  1172.     ASSEMBLER
  1173.         CLR.L   (A3)+
  1174.         JSR     Malloc
  1175.         MOVE.L  -(A3),D0
  1176.         MOVEA.L -(A3),A0
  1177.         MOVE.L  D0,(A0)
  1178.     END
  1179.   END SysAlloc;
  1180.  
  1181.  
  1182. (*$L-*)
  1183. PROCEDURE DEALLOCATE ( VAR addr: ADDRESS; len: LONGCARD );
  1184.   BEGIN
  1185.     ASSEMBLER
  1186.         TST.L   MPBPtr
  1187.         BNE     ok
  1188.         CLR.L   -4(A3)          ; alles freigeben
  1189.      ok JSR     Resize0
  1190.         SUBQ.L  #2,A3
  1191.     END
  1192.   END DEALLOCATE;
  1193.  
  1194.  
  1195. (*$L-*)
  1196. PROCEDURE Enlarge ( VAR addr: ADDRESS; len: LONGCARD; VAR ok: BOOLEAN );
  1197.   BEGIN
  1198.     ASSEMBLER
  1199.         MOVE.L  -(A3),-(A7)
  1200.         NEG.L   -4(A3)
  1201.         BPL     err
  1202.         TST.L   MPBPtr
  1203.         BEQ     err
  1204.         JSR     Resize0
  1205.         MOVE.L  (A7)+,A0
  1206.         MOVE.W  -(A3),(A0)
  1207.         RTS
  1208.       err
  1209.         SUBQ.L  #8,A3
  1210.         MOVE.L  (A7)+,A0
  1211.         CLR.W   (A0)
  1212.     END
  1213.   END Enlarge;
  1214.  
  1215.  
  1216. (*$L-*)
  1217. PROCEDURE trailAv1; (* D6: MPBPtr, D5: start *)
  1218. BEGIN
  1219. ASSEMBLER
  1220.         ; used-MD finden
  1221.         JSR     findMD
  1222.         BEQ.S   endeClr
  1223.  
  1224.         ; anschließenden Free-MD ermitteln
  1225.         MOVE.L  MD.start(A0),D2
  1226.         ADD.L   MD.length(A0),D2        ; hier muß ein Freibereich stehen
  1227.         MOVE.L  D6,A2
  1228.         MOVE.L  MPB.free(A2),A2
  1229.         BRA.S   cont2
  1230. srch2   CMP.L   MD.start(A2),D2 ; start aus Free-List
  1231.         BEQ.S   fnd2            ; gefunden
  1232.         MOVE.L  (A2),A2         ; MD.next
  1233. cont2   MOVE.L  A2,D0
  1234.         BNE     srch2
  1235.         BRA.S   endeClr         ; dahinter nix mehr frei
  1236. fnd2    MOVE.L  MD.length(A2),D0 ; free-Länge
  1237.         BRA.S   ende
  1238.  
  1239. endeClr MOVEQ   #0,D0
  1240. ende
  1241. END
  1242. END  trailAv1;
  1243.  
  1244. (*$L-*)
  1245. PROCEDURE TrailAvail (ad: ADDRESS): LONGCARD;
  1246.   BEGIN
  1247.     ASSEMBLER
  1248.         MOVEM.L D5/D6,-(A7)
  1249.         MOVE.L  -(A3),D5
  1250.         MOVEQ   #0,D0
  1251.         MOVE.L  MPBPtr,D6
  1252.         BEQ.S   null
  1253.         PEA     trailAv1
  1254.         JSR     CallSuper
  1255.         ADDQ.L  #4,A7
  1256.       null
  1257.         MOVE.L  D0,(A3)+
  1258.         MOVEM.L (A7)+,D5/D6
  1259.     END
  1260.   END TrailAvail;
  1261.  
  1262.  
  1263. (*$L-*)
  1264. PROCEDURE MemSize ( addr: ADDRESS ): LONGCARD;
  1265.   BEGIN
  1266.     ASSEMBLER
  1267.         TST.L   MPBPtr
  1268.         BEQ.s   err
  1269.  
  1270.         MOVE.L  D5,-(A7)
  1271.         MOVE.L  -(A3),D5
  1272.         PEA     l(PC)
  1273.         JSR     CallSuper
  1274.         ADDQ.L  #4,A7
  1275.         MOVE.L  (A7)+,D5
  1276.         MOVE.L  D0,(A3)+
  1277.         RTS
  1278.  
  1279. err     SUBQ.L  #4,A3
  1280.         LINK    A5,#0
  1281.         JSR     IllCall
  1282.         UNLK    A5
  1283.         CLR.L   (A3)+
  1284.         RTS
  1285.  
  1286.       l MOVE    SR,-(A7)
  1287.         ORI     #$700,SR
  1288.         MOVE.L  D6,-(A7)
  1289.         MOVE.L  MPBPtr,D6
  1290.         JSR     findMD          ; zerstört D5
  1291.         BEQ.S   e
  1292.         MOVE.L  MD.length(A0),D0
  1293.         TST.B   MD.owner(A0)
  1294.         BPL.S   e
  1295.         SUBQ.L  #1,D0
  1296.       e MOVE.L  (A7)+,D6
  1297.         MOVE    (A7)+,SR
  1298.     END
  1299.   END MemSize;
  1300.  
  1301. (*$L-*)
  1302. PROCEDURE avail;
  1303.   BEGIN
  1304.     ASSEMBLER
  1305.         TST.L   MPBPtr
  1306.         BEQ     norm
  1307.         PEA     l(PC)
  1308.         JSR     CallSuper
  1309.         ADDQ.L  #4,A7
  1310.         RTS
  1311.  
  1312. norm    ; IN: D2: 1 -> AllAvail bestimmen
  1313.         TST.W   D2
  1314.         BNE     all
  1315.         
  1316.         MOVEQ   #-1,D0
  1317.         MOVE.L  D0,-(A7)
  1318.         MOVE    #$48,-(A7)      ; malloc (-1L)
  1319.         TRAP    #1
  1320.         ADDQ.L  #6,A7
  1321.         RTS
  1322.         
  1323. all     MOVE.L  D3,-(A7)
  1324.         MOVEQ   #0,D3           ; zählt Gesamtmenge
  1325.         CLR.L   -(A7)           ; Endmarke für gestackte Alloc-Adressen
  1326. luup    MOVEQ   #-1,D0
  1327.         MOVE.L  D0,-(A7)
  1328.         MOVE    #$48,-(A7)      ; malloc (-1L)
  1329.         TRAP    #1
  1330.         ADDQ.L  #6,A7
  1331.         ADD.L   D0,D3
  1332.         CMPI.L  #1024,D0        ; Bereiche < 1024 nicht berücksichtigen
  1333.         BCS     ende
  1334.         MOVE.L  D0,-(A7)
  1335.         MOVE    #$48,-(A7)      ; malloc ()
  1336.         TRAP    #1
  1337.         ADDQ.L  #6,A7
  1338.         MOVE.L  D0,-(A7)        ; Adr des Bereichs merken
  1339.         MOVE.L  A3,A0
  1340.         ADDA.W  #512,A0
  1341.         CMPA.L  A7,A0           ; Aufhören bei drohendem Stacküberlauf
  1342.         BCS     luup
  1343. ende    TST.L   (A7)
  1344.         BEQ     ende2
  1345.         MOVE    #m_free,-(A7)
  1346.         TRAP    #1
  1347.         ADDQ.L  #6,A7
  1348.         BRA     ende
  1349. ende2   ADDQ.L  #4,A7
  1350.         MOVE.L  D3,D0
  1351.         MOVE.L  (A7)+,D3
  1352.         RTS
  1353.  
  1354.         (*
  1355.         MOVEQ   #-1,D0
  1356.         MOVE.L  D0,-(A7)
  1357.         MOVE    #$48,-(A7)      ; malloc (-1L)
  1358.         TRAP    #1
  1359.         ADDQ.L  #6,A7
  1360.         MOVE.L  D0,D1
  1361.         TST     gemdos1900
  1362.         BEQ     noMX
  1363.         MOVE.L  D0,-(A7)
  1364.         MOVE.W  #1,-(A7)
  1365.         MOVE.L  #-1,-(A7)
  1366.         MOVE    #$44,-(A7)      ; mxalloc (-1L, 1)
  1367.         TRAP    #1
  1368.         ADDQ.L  #8,A7
  1369.         MOVE.L  D0,D1
  1370.         MOVE.L  (A7)+,D0
  1371.         ADD.L   D1,D0
  1372.         RTS
  1373.         *)
  1374.  
  1375.       l ; MOVE    SR,-(A7)
  1376.         ; ORI     #$700,SR
  1377.         CLR.L   D0
  1378.         CLR.L   D1
  1379.         MOVE.L  MPBPtr,A0
  1380.         MOVE.L  (A0),A0
  1381.       s ADD.L   MD.length(A0),D1
  1382.         CMP.L   MD.length(A0),D0
  1383.         BCC     c
  1384.         MOVE.L  MD.length(A0),D0
  1385.       c MOVE.L  (A0),A0
  1386.         MOVE.L  A0,D2
  1387.         BNE     s
  1388.         TST.W   D2
  1389.         BEQ     single
  1390.         MOVE.L  D1,D0
  1391.       single
  1392.         ; MOVE    (A7)+,SR
  1393.     END
  1394.   END avail;
  1395.  
  1396. (*$L-*)
  1397. PROCEDURE MemAvail (): LONGCARD;
  1398.   BEGIN
  1399.     ASSEMBLER
  1400.         MOVEQ   #0,D2
  1401.         JSR     avail
  1402.         MOVE.L  D0,(A3)+
  1403.     END
  1404.   END MemAvail;
  1405.  
  1406. (*$L-*)
  1407. PROCEDURE AllAvail (): LONGCARD;
  1408.   BEGIN
  1409.     ASSEMBLER
  1410.         MOVEQ   #1,D2
  1411.         JSR     avail
  1412.         MOVE.L  D0,(A3)+
  1413.     END
  1414.   END AllAvail;
  1415.  
  1416. (*$L-*)
  1417. PROCEDURE Available (l:LONGCARD):BOOLEAN;
  1418.   BEGIN
  1419.     ASSEMBLER
  1420.         MOVEQ   #0,D2
  1421.         JSR     avail
  1422.         CMP.L   -(A3),D0
  1423.         SCC     D0
  1424.         ANDI    #1,D0
  1425.         MOVE    D0,(A3)+
  1426.     END
  1427.   END Available;
  1428.  
  1429. (*$L-*)
  1430. PROCEDURE Keep ( addr: ADDRESS );
  1431.   BEGIN
  1432.     ASSEMBLER
  1433.         TST.L   MPBPtr
  1434.         BEQ.S   err
  1435.         MOVE.L  D3,-(A7)
  1436.         MOVE.L  -(A3),D3
  1437.         PEA     l(PC)
  1438.         JSR     CallSuper
  1439.         ADDQ.L  #4,A7
  1440.         MOVE.L  (A7)+,D3
  1441.         RTS
  1442.  
  1443. err     SUBQ.L  #4,A3
  1444.         LINK    A5,#0
  1445.         JSR     IllCall
  1446.         UNLK    A5
  1447.         RTS
  1448.  
  1449.      l: MOVE    SR,-(A7)
  1450.         ORI     #$700,SR
  1451.         MOVE.L  MPBPtr,A0
  1452.         ADDQ.L  #MPB.used,A0    ; LEA MPB.used(A0),A0
  1453.         BRA     cont0
  1454. srch0   CMP.L   MD.start(A0),D3
  1455.         BEQ     found
  1456. cont0   MOVE.L  (A0),A0         ; MD.next
  1457.         MOVE.L  A0,D0
  1458.         BNE     srch0
  1459.         BRA     ende
  1460. found   MOVE.B  MD.owner(A0),D0
  1461.         CLR.L   MD.owner(A0)    ; Prozeß-ID löschen
  1462.         MOVE.B  D0,MD.owner(A0)
  1463. ende    MOVE    (A7)+,SR
  1464.     END
  1465.   END Keep;
  1466.  
  1467.  
  1468. (*$L-*)
  1469. PROCEDURE KeepAll (processID:LONGWORD);
  1470.   BEGIN
  1471.     ASSEMBLER
  1472.         TST.L   MPBPtr
  1473.         BEQ.S   err
  1474.         MOVE.L  D3,-(A7)
  1475.         MOVE.L  -(A3),D3
  1476.         PEA     l(PC)
  1477.         JSR     CallSuper
  1478.         ADDQ.L  #4,A7
  1479.         MOVE.L  (A7)+,D3
  1480.         RTS
  1481.  
  1482. err     SUBQ.L  #4,A3
  1483.         LINK    A5,#0
  1484.         JSR     IllCall
  1485.         UNLK    A5
  1486.         RTS
  1487.  
  1488.      l: ; alle MD mit owner=D3 resident machen
  1489.         MOVE    SR,-(A7)
  1490.         ORI     #$700,SR
  1491.         MOVE.L  MPBPtr,A0
  1492.         ADDQ.L  #MPB.used,A0    ; LEA MPB.used(A0),A0
  1493.         BRA     cont0
  1494. srch0   MOVE.L  MD.owner(A0),D0
  1495.         ANDI.L  #$00FFFFFF,D0   ; oberes Byte ausblenden
  1496.         CMP.L   D0,D3
  1497.         BNE     cont0
  1498.         MOVE.B  MD.owner(A0),D0
  1499.         CLR.L   MD.owner(A0)    ; Prozeß-ID löschen
  1500.         MOVE.B  D0,MD.owner(A0)
  1501. cont0   MOVE.L  (A0),A0         ; MD.next
  1502.         MOVE.L  A0,D0
  1503.         BNE     srch0
  1504.         MOVE    (A7)+,SR
  1505.     END
  1506.   END KeepAll;
  1507.  
  1508.  
  1509. (*$L-*)
  1510. PROCEDURE FullStorBaseAccess (): BOOLEAN;
  1511.   BEGIN
  1512.     ASSEMBLER
  1513.         TST.L   MPBPtr
  1514.         SNE     D0
  1515.         ANDI    #1,D0
  1516.         MOVE    D0,(A3)+
  1517.     END
  1518.   END FullStorBaseAccess;
  1519.  
  1520.  
  1521. (*$L+*)
  1522. PROCEDURE Inconsistent (): BOOLEAN;
  1523.   BEGIN
  1524.     (*!!! noch ausprogrammieren *)
  1525.     RETURN FALSE
  1526.   END Inconsistent;
  1527.  
  1528.  
  1529. (*$L-*)
  1530. PROCEDURE Resize ( VAR addr: ADDRESS; newSize: LONGCARD; VAR ok: BOOLEAN);
  1531.   BEGIN
  1532.     ASSEMBLER
  1533.         MOVE.L  -(A3),-(A7)
  1534.         TST.L   -4(A3)
  1535.         BEQ     all
  1536.         TST.L   MPBPtr
  1537.         BEQ     noFull
  1538.         MOVE.L  -8(A3),A0
  1539.         MOVE.L  (A0),(A3)+
  1540.         JSR     MemSize
  1541.         MOVE.L  -(A3),D0
  1542.         SUB.L   -(A3),D0
  1543.         MOVE.L  D0,(A3)+
  1544.       all
  1545.         JSR     Resize0
  1546.         MOVE.L  (A7)+,A0
  1547.         MOVE.W  -(A3),(A0)
  1548.         RTS
  1549.       noFull
  1550.         MOVE.L  -(A3),-(A7)     ; neue Länge
  1551.         MOVE.L  -(A3),A0
  1552.         MOVE.L  (A0),-(A7)      ; start
  1553.         CLR     -(A7)
  1554.         MOVE    #m_shrink,-(A7)
  1555.         TRAP    #1              ; Mshrink ()
  1556.         ADDA.W  #12,A7
  1557.         MOVE.L  (A7)+,A0
  1558.         TST.L   D0
  1559.         SEQ     D0
  1560.         ANDI    #1,D0
  1561.         MOVE    D0,(A0)
  1562.     END
  1563.   END Resize;
  1564.  
  1565.  
  1566. (*$L-*)
  1567. PROCEDURE More (id:INTEGER;p:ADDRESS);
  1568.   BEGIN
  1569.     ASSEMBLER
  1570.         MOVE.L  -(A3),A0
  1571.         MOVE.W  -(A3),D0
  1572.         CMPI.W  #$4EF1,D0
  1573.         BNE     trail
  1574.         MOVE.L  (A0)+,(A3)+
  1575.         MOVE.L  (A0)+,(A3)+
  1576.         MOVE.L  (A0)+,(A3)+
  1577.         ; Enlarge ( VAR addr: ADDRESS; len: LONGCARD; VAR ok: BOOLEAN );
  1578.         JMP     Enlarge
  1579.       trail
  1580.         CMPI.W  #$4EF2,D0
  1581.         BNE     ende
  1582.         MOVE.L  (A0)+,(A3)+
  1583.         MOVE.L  A0,-(A7)
  1584.         ; TrailAvail (ad: ADDRESS): LONGCARD;
  1585.         JSR     TrailAvail
  1586.         MOVE.L  (A7)+,A0
  1587.         MOVE.L  -(A3),(A0)
  1588.       ende
  1589.         TRAP    #6
  1590.         DC.W    IllegalCall
  1591.     END
  1592.   END More;
  1593.  
  1594.  
  1595. (*$L-*)
  1596. PROCEDURE terminate;
  1597.   BEGIN
  1598.     ASSEMBLER
  1599.         MOVE.L  ProcessID,A0
  1600.         MOVE.L  (A0),(A3)+
  1601.         JMP     DeAllocAll
  1602.     END
  1603.   END terminate;
  1604.  
  1605. (*$L-*)
  1606. PROCEDURE chgLevel ( doInc: BOOLEAN; child: BOOLEAN; VAR c: INTEGER );
  1607.   BEGIN
  1608.     ASSEMBLER
  1609.         SUBQ.L  #4,A3
  1610.         MOVE.L  -(A3),D0
  1611.         TST     D0
  1612.         BEQ     ende
  1613.         SWAP    D0
  1614.         TST     D0
  1615.         BNE     ende
  1616.         JMP     terminate
  1617.       ende
  1618.     END
  1619.   END chgLevel;
  1620.  
  1621.  
  1622. VAR ehdl: EnvlpCarrier;
  1623.     thdl: TermCarrier;
  1624.     wsp: MemArea;
  1625.     stack: ARRAY [1..200] OF WORD;
  1626.     v: CARDINAL; r: CARDINAL; d: Date;
  1627.     isTT: BOOLEAN;
  1628.     MiNTorMagXavail: BOOLEAN;
  1629.  
  1630. BEGIN (* main *)
  1631.   ASSEMBLER
  1632.         SF      oldStorage
  1633.         (* diese Methode ist nicht so gut, um mxalloc()-Vorhandensein zu
  1634.            prüfen. Besser: mxalloc aufrufen und prüfen, ob neg. Returncode
  1635.            ("ill.opcode") geliefert wird.
  1636.         MOVE    #$30,-(A7)      ; Sversion
  1637.         TRAP    #1
  1638.         ADDQ.L  #2,A7
  1639.         CMPI.W  #$1900,D0
  1640.         SCC     D0
  1641.         ANDI    #1,D0
  1642.         MOVE.W  D0,gemdos1900
  1643.         *)
  1644.         
  1645.         ; Ist MiNT installiert?
  1646.         MOVE.L  #$4D694E54,(A3)+
  1647.         SUBQ.L  #4,A7
  1648.         MOVE.L  A7,(A3)+
  1649.         JSR     GetCookie
  1650.         ADDQ.L  #4,A7           ; value ist uninteressant
  1651.         MOVE.W  -(A3),MiNTorMagXavail
  1652.         BNE     weiter
  1653.         ; Ist Mag!X installiert?
  1654.         MOVE.L  #$4D616758,(A3)+
  1655.         SUBQ.L  #4,A7
  1656.         MOVE.L  A7,(A3)+
  1657.         JSR     GetCookie
  1658.         ADDQ.L  #4,A7           ; value ist uninteressant
  1659.         MOVE.W  -(A3),MiNTorMagXavail
  1660.       weiter:
  1661.  
  1662.         PEA     g(PC)
  1663.         JSR     CallSuper
  1664.         ADDQ.L  #4,A7
  1665.         BRA     cont
  1666.       g MOVE.L  $4F2,A0           ; sysbase
  1667.         CMPI.B  #3,2(A0)
  1668.         SCC     D0              ; isTT:= TOS-Version >= 3
  1669.         ANDI    #1,D0
  1670.         MOVE    D0,isTT
  1671.         RTS
  1672.       cont:
  1673.   END;
  1674.   IF ExtendedMemoryAccess AND NOT isTT AND ~MiNTorMagXavail THEN
  1675.     GetMPBPtr;
  1676.   END;
  1677.   IF MPBPtr # NIL THEN
  1678.     ASSEMBLER
  1679.         ; Longstack bei TOS 1.0 / 1.2 ermitteln
  1680.         BRA     c
  1681.      t: MOVE.L  $4F2,A0         ; ^TOS-Header
  1682.         MOVE.L  8(A0),D0        ; wg. altem AHDI
  1683.         RTS
  1684.      c: PEA     t(PC)
  1685.         MOVE    #38,-(A7)
  1686.         TRAP    #14             ; Supexec
  1687.         ADDQ.L  #6,A7
  1688.         MOVE.L  D0,A0
  1689.         MOVE.W  2(A0),D1
  1690.         CMPI    #$0100,D1
  1691.         BNE     a
  1692.         MOVE.L  #$56FE,MDRoot
  1693.         MOVE.L  #$5FDE,LStackFree
  1694.         MOVE.L  #$414E,LStackPtr
  1695.         MOVE.L  #$29DC,LongStack
  1696.         BRA     o
  1697.      a: MOVE.L  $20(A0),D0
  1698.         ADDQ.L  #4,D0
  1699.         MOVE.L  D0,MDRoot
  1700.         CMPI    #$0102,D1
  1701.         BNE     e
  1702.         MOVE.L  #$8780,LStackFree
  1703.         MOVE.L  #$68F0,LStackPtr
  1704.         MOVE.L  #$2A6E,LongStack
  1705.      o: ST      oldStorage
  1706.      e: MOVE.L  #stack,wsp
  1707.     END
  1708.   END;
  1709.   wsp.length:= SIZE (stack);
  1710.   CatchProcessTerm (thdl,terminate,wsp);
  1711.   SetEnvelope (ehdl,chgLevel,wsp)
  1712. END StorBase.
  1713.